home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / slib / macwork.scm < prev    next >
Encoding:
Text File  |  1994-05-25  |  3.8 KB  |  127 lines
  1. ;;;; "macwork.scm": Will Clinger's macros that work.    -*- Scheme -*-
  2. ;Copyright 1992 William Clinger
  3. ;
  4. ; Permission to copy this software, in whole or in part, to use this
  5. ; software for any lawful purpose, and to redistribute this software
  6. ; is granted subject to the restriction that all copies made of this
  7. ; software must include this copyright notice in full.
  8. ;
  9. ; I also request that you send me a copy of any improvements that you
  10. ; make to this software so that they may be incorporated within it to
  11. ; the benefit of the Scheme community.
  12.  
  13. (slib:load (in-vicinity (program-vicinity) "mwexpand"))
  14.  
  15. ;;;; Miscellaneous routines.
  16.  
  17. (define (mw:warn msg . more)
  18.   (display "WARNING from macro expander:")
  19.   (newline)
  20.   (display msg)
  21.   (newline)
  22.   (for-each (lambda (x) (write x) (newline))
  23.         more))
  24.  
  25. (define (mw:error msg . more)
  26.   (display "ERROR detected during macro expansion:")
  27.   (newline)
  28.   (display msg)
  29.   (newline)
  30.   (for-each (lambda (x) (write x) (newline))
  31.         more)
  32.   (mw:quit #f))
  33.  
  34. (define (mw:bug msg . more)
  35.   (display "BUG in macro expander: ")
  36.   (newline)
  37.   (display msg)
  38.   (newline)
  39.   (for-each (lambda (x) (write x) (newline))
  40.         more)
  41.   (mw:quit #f))
  42.  
  43. ; Given a <formals>, returns a list of bound variables.
  44.  
  45. (define (mw:make-null-terminated x)
  46.   (cond ((null? x) '())
  47.     ((pair? x)
  48.      (cons (car x) (mw:make-null-terminated (cdr x))))
  49.     (else (list x))))
  50.  
  51. ; Returns the length of the given list, or -1 if the argument
  52. ; is not a list.  Does not check for circular lists.
  53.  
  54. (define (mw:safe-length x)
  55.   (define (loop x n)
  56.     (cond ((null? x) n)
  57.       ((pair? x) (loop (cdr x) (+ n 1)))
  58.       (else -1)))
  59.   (loop x 0))
  60.  
  61. (require 'common-list-functions)
  62.  
  63. ; Given an association list, copies the association pairs.
  64.  
  65. (define (mw:syntax-copy alist)
  66.   (map (lambda (x) (cons (car x) (cdr x)))
  67.        alist))
  68.  
  69. ;;;; Implementation-dependent parameters and preferences that determine
  70. ; how identifiers are represented in the output of the macro expander.
  71. ;
  72. ; The basic problem is that there are no reserved words, so the
  73. ; syntactic keywords of core Scheme that are used to express the
  74. ; output need to be represented by data that cannot appear in the
  75. ; input.  This file defines those data.
  76.  
  77. ; The following definitions assume that identifiers of mixed case
  78. ; cannot appear in the input.
  79.  
  80. ;(define mw:begin1  (string->symbol "Begin"))
  81. ;(define mw:define1 (string->symbol "Define"))
  82. ;(define mw:quote1  (string->symbol "Quote"))
  83. ;(define mw:lambda1 (string->symbol "Lambda"))
  84. ;(define mw:if1     (string->symbol "If"))
  85. ;(define mw:set!1   (string->symbol "Set!"))
  86.  
  87. (define mw:begin1  'begin)
  88. (define mw:define1 'define)
  89. (define mw:quote1  'quote)
  90. (define mw:lambda1 'lambda)
  91. (define mw:if1     'if)
  92. (define mw:set!1   'set!)
  93.  
  94. ; The following defines an implementation-dependent expression
  95. ; that evaluates to an undefined (not unspecified!) value, for
  96. ; use in expanding the (define x) syntax.
  97.  
  98. (define mw:undefined (list (string->symbol "Undefined")))
  99.  
  100. ; A variable is renamed by suffixing a vertical bar followed by a unique
  101. ; integer.  In IEEE and R4RS Scheme, a vertical bar cannot appear as part
  102. ; of an identifier, but presumably this is enforced by the reader and not
  103. ; by the compiler.  Any other character that cannot appear as part of an
  104. ; identifier may be used instead of the vertical bar.
  105.  
  106. (define mw:suffix-character #\|)
  107.  
  108. (slib:load (in-vicinity (program-vicinity) "mwdenote"))
  109. (slib:load (in-vicinity (program-vicinity) "mwsynrul"))
  110.  
  111. (define macro:expand macwork:expand)
  112.  
  113. ;;; Here are EVAL, EVAL! and LOAD which expand macros.  You can replace the
  114. ;;; implementation's eval and load with them if you like.
  115. (define base:eval slib:eval)
  116. (define base:load load)
  117.  
  118. (define (macwork:eval x) (base:eval (macwork:expand x)))
  119. (define macro:eval macwork:eval)
  120.  
  121. (define (macwork:load <pathname>)
  122.   (slib:eval-load <pathname> macwork:eval))
  123. (define macro:load macwork:load)
  124.  
  125. (provide 'macros-that-work)
  126. (provide 'macro)
  127.